home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr48 / pas_0593.zip / TIMER.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-30  |  3KB  |  131 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 741 of 775
  3. From : Dj Murdoch                          1:249/99.5           07 May 93  22:23
  4. To   : Sean Palmer
  5. Subj : Timer code
  6. ────────────────────────────────────────────────────────────────────────────────}
  7.  {$G+,S-,R-,Q-}
  8.  program timer;
  9.  
  10.  { Program to time short segments of code; inspired by Michael Abrash's
  11.    Zen timer.  Donated to the public domain by D.J. Murdoch }
  12.  
  13.  uses
  14.    opdos; { Object Professional unit, needed only for TimeMS,
  15.             a millisecond timer. }
  16.  
  17.  const
  18.    onetick = 1/33E6;  { This is the time in seconds for one cpu cycle.
  19.                         I've got it set for a 33 Mhz machine. }
  20.  
  21.  { Instructions:  put your code fragment into a short routine called Segment.
  22.    It should leave the stack unchanged, or it'll blow up when we clone it.
  23.    It *must* have a far return at the end.  Play around with declaring it
  24.    as an assembler procedure or not to see the cost of the TP entry and
  25.    exit code. }
  26.  
  27.  { This example is Sean Palmer's "var2 := var1 div 2" replacement fragment. }
  28.  
  29.  var
  30.    var1,var2 : integer;
  31.  
  32.  procedure Segment; far; assembler;
  33.  asm
  34.     mov ax,var1
  35.     sar ax,1
  36.     jns @S
  37.     adc ax,0
  38.   @S:
  39.     mov var2,ax
  40.  end;
  41.  
  42.  { This is the comparison TP code.  Note that it includes entry/exit code;
  43.    play around with variations on the assembler version to make it a fair
  44.    comparison }
  45.  (*
  46.  procedure Segment; far;
  47.  begin
  48.    var2 := var1 div 2;
  49.  end;
  50.  *)
  51.  
  52.  { This procedure is essential!!! Do not move it. It must follow
  53.    Segment directly. }
  54.  procedure Stop;
  55.  begin
  56.  end;
  57.  
  58.  { This routine will only be called once at the beginning of the program;
  59.    set up any variables that Segment needs }
  60.  
  61.  procedure Setup;
  62.  begin
  63.    var1 := 5;
  64.    writeln('This run, var1=',var1);
  65.  end;
  66.  
  67.  const
  68.    maxsize=65520;
  69.    RETF   = $CB;
  70.  var
  71.    p : pointer;
  72.    src,dest : ^byte;
  73.    size : word;
  74.    repeats : word;
  75.    i : word;
  76.    start,finish : longint;
  77.    count : longint;
  78.    main,overhead,millisecs : real;
  79.  begin
  80.  
  81.    setup;
  82.  
  83.    { Get a segment of memory, and fill it up with as many copies
  84.      of the segment as possible }
  85.  
  86.    size := ofs(stop) - ofs(Segment) -1;
  87.    repeats := maxsize div size;
  88.    getmem(p, size*repeats + 1);
  89.    src := @Segment;
  90.    dest := p;
  91.    for i:=1 to repeats do
  92.    begin
  93.      move(src^,dest^,size);
  94.      inc(dest,size);
  95.    end;
  96.    { Add a final RETF at the end. }
  97.    dest^ := RETF;
  98.  
  99.    { Now do the timing.  Keep repeating one second loops indefinitely. }
  100.  
  101.    writeln(' Bytes     Clocks       ns       MIPS');
  102.    repeat
  103.      { First loop:  one second worth of calls to the segment }
  104.      start := timems;
  105.      count := 0;
  106.      repeat
  107.        asm
  108.          call dword ptr p
  109.        end;
  110.        finish := timems;
  111.        inc(count);
  112.      until finish > 1000+start;
  113.      main := (finish - start)/repeats/count;
  114.  
  115.      { Second loop:  1/2 second worth of calls to the RETF }
  116.      start := timems;
  117.      count := 0;
  118.      repeat
  119.        asm
  120.          call dword ptr dest
  121.        end;
  122.        finish := timems;
  123.        inc(count);
  124.      until finish > 500+start;
  125.      overhead := (finish-start)/count;
  126.      millisecs := (main-overhead/repeats);
  127.      writeln(size:6,millisecs/1000/onetick:11:1,
  128.                     1.e6*millisecs:11:0,
  129.                     1/millisecs/1000:11:3);
  130.    until false;
  131.  end.